home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / quadrille.srx < prev    next >
Text File  |  2000-02-29  |  2KB  |  109 lines
  1. /*********************************\
  2. ** Quadrille v1.0 for Solitarexx **
  3. **     by Michal Szafranski      **
  4. \*********************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = 'Quadrille'
  8. wintex = '"We Have a Winner"'
  9. seq.4 = 'B 0 2 4 6 8 10 12 E'
  10. seq.5 = 'B 1 3 5 7 9 11 E'
  11. ADDBUTTON 0 10 "Start"
  12. ADDTEXT 4 42 tex 6
  13. ADDBUTTON 12 10 "Abort"
  14. ADDTEXT 14 42 tex 6
  15. SELECTGUI 1
  16.  
  17. SCREENSIZE 3 0 7 0
  18. DO i = 0 TO 8
  19.     NEWSTACK 3 0 0 (i%3)+4 (i//3)
  20.     stack.i = RESULT
  21. END
  22. DO i = 0 TO 3
  23.     NEWSTACK 4 0 i+2 (i//4)
  24.     base.i = RESULT
  25. END
  26. DO i = 4 TO 7
  27.     NEWSTACK 5 0 0 (i//4) 1
  28.     base.i = RESULT
  29. END
  30. NEWSTACK 1 0 1 1 2 0 0
  31. deck = RESULT
  32. NEWSTACK 2 32+8+1 1 2 2 0 0 2 2
  33. waste = RESULT
  34. ADDCARDS deck SHUFFLED
  35.  
  36. DO FOREVER
  37.     ACTION
  38.     PARSE VAR RESULT act rest
  39.     IF act = 1 THEN EXIT
  40.     IF act = 3 THEN CALL GAME
  41. END
  42.  
  43. GAME:
  44.     CLEANUP deck
  45.     SETGADGET 14 STR tex
  46.     SELECTGUI 4
  47.     sel = 0
  48.     fin = 0
  49.     DO i=0 TO 8
  50.         CARDSELECT deck 1
  51.         MOVECARDS deck stack.i REVERSE
  52.     END
  53.     DO FOREVER
  54.         ACTION
  55.         PARSE VAR RESULT act stack sid card
  56.         IF act = 1 THEN EXIT
  57.         IF act = 2 THEN SELECT
  58.             WHEN sid=1 THEN CALL DODECK
  59.             WHEN sel=0 & card>0 & sid<4 THEN sel = stack
  60.             WHEN sel>0 & (sel = stack | sid > 3) THEN CALL DOBASE
  61.             OTHERWISE ERRBEEP
  62.         END
  63.         IF act = 3 THEN DO
  64.             SELECTGUI 1
  65.             RETURN
  66.         END
  67.     END
  68. RETURN
  69. DODECK:
  70.     sel=0
  71.     CARDSELECT deck 1
  72.     MOVECARDS deck waste REVERSE
  73. RETURN
  74. DOBASE:
  75.     IF sel~=stack THEN CALL CHBASE
  76.     ELSE DO i= 0 TO 7 UNTIL ok=0
  77.         sid = 4+(i%4)
  78.         stack = base.i
  79.         CALL CHBASE
  80.     END
  81.     IF ok=0 THEN DO
  82.         fin = fin +1
  83.         MOVECARDS sel stack
  84.         IF fin = 52 THEN SETGADGET 14 STR wintex
  85.         IF sel ~= waste THEN DO
  86.             CARDSELECT waste 1
  87.             IF RESULT ~= '' THEN MOVECARDS waste sel
  88.             ELSE DO
  89.                 CARDSELECT deck 1
  90.                 MOVECARDS deck sel REVERSE
  91.             END
  92.         END
  93.     END
  94.     ELSE ERRBEEP
  95.     sel = 0
  96. RETURN
  97. CHBASE:
  98.     CARDSELECT sel 1
  99.     PARSE VAR RESULT kolors wars xx
  100.     CARDSELECT stack 1
  101.     PARSE VAR RESULT kolor war xxx
  102.     IF kolor = '' THEN DO
  103.         kolor = kolors
  104.         war = 'B'
  105.     END
  106.     IF kolor = kolors & FIND(seq.sid,war wars)>0 THEN ok = 0
  107.     ELSE ok = 1
  108. RETURN
  109.